IRT

library(tidyverse)
library(ggplot2)
library(dplyr)
library(lubridate)
library(plyr)
library(cluster)
library(MASS)
library(readxl)
library(gridExtra)

Importamos los datos. Nos quedamos unicamente con las respuestas a las 33 preguntas de cada alumno (4to curso UIB y Valencia)

datosValencia_T1 <- read_excel("/Users/MariaJose/Desktop/TFG/Encuesta/PID_E_II_control3_T1T2T3_4codificado-1.xlsx", sheet = "control3_T1", range = cell_cols("AN:BT")) %>%
  dplyr::rename(Pregunta_1 = "1. Me resulta facil darme cuenta de las intenciones de las personas que me rodean",
                Pregunta_2 = "2. Me siento bien si los demas se divierten (lo pasan bien)",
                Pregunta_3 = "3. No me pongo triste solo porque un amigo lo este",
                Pregunta_4 = "4. Si un amigo consigue un trabajo muy deseado, me entusiasmo con el",
                Pregunta_5 = "5. Me afecta demasiado ver programas de television donde se muestran los problemas de otras personas",
                Pregunta_6 = "6. Antes de tomar una decision, intento tener en cuenta todos los puntos de vista",
                Pregunta_7 = "7. Rara vez reconozco como se siente una persona con solo mirarla",
                Pregunta_8 = "8. Me afecta poco escuchar desgracias sobre personas desconocidas",
                Pregunta_9 = "9. Me hace ilusion  ver que un amigo nuevo se encuentra a gusto en nuestro grupo",
                Pregunta_10 = "10. Me es dificil entender como se siente una persona ante una situacion que no he vivido",
                Pregunta_11 = "11. Cuando un amigo se ha portado mal conmigo, intento entender los motivos por los que lo ha hecho",
                Pregunta_12 = "12. A menos que se trate de algo muy grave, me cuesta llorar con lo que les sucede a otros",
                Pregunta_13 = "13. Reconozco facilmente cuando alguien esta de mal humor",
                Pregunta_14 = "14. No siempre me doy cuenta cuando la persona que tengo al lado se siente mal",
                Pregunta_15 = "15. Intento ponerme en el lugar de los demas para saber como actuaran",
                Pregunta_16 = "16. Cuando a alguien le sucede algo bueno, siento alegria",
                Pregunta_17 = "17. Si tengo una opinion formada no presto mucha atencion a los argumentos de los demas",
                Pregunta_18 = "18. A veces sufro mas con las desgracias de los demas que ellos mismos",
                Pregunta_19 = "19. Me siento feliz solo con ver felices a otras personas",
                Pregunta_20 = "20. Cuando alguien tiene un problema, intento imaginarme como me sentiria si estuviera en su lugar",
                Pregunta_21 = "21. No siento especial alegria si alguien me cuenta que ha tenido un golpe de suerte",
                Pregunta_22 = "22. Cuando veo que alguien  recibe un regalo no puedo reprimir una sonrisa",
                Pregunta_23 = "23. No puedo evitar llorar con los testimonios de personas desconocidas",
                Pregunta_24 = "24. Cuando conozco gente nueva me doy cuenta de la impresion que se han llevado de mi",
                Pregunta_25 = "25. Cuando mis amigos me cuentan que les va bien, no le doy mucha importancia",
                Pregunta_26 = "26. Encuentro dificil ver las cosas desde el punto de vista de otras personas",
                Pregunta_27 = "27. Entender como se siente otra persona es algo muy facil para mi",
                Pregunta_28 = "28. No soy de esas personas que se deprimen con los problemas de los demas",
                Pregunta_29 = "29. Intento comprender mejor a mis amigos mirando las situaciones desde su perspectiva",
                Pregunta_30 = "30. Me considero una persona fria porque no me conmuevo facilmente",
                Pregunta_31 = "31. Me doy cuenta cuando las personas cercanas a mi estan especialmente contentas, aunque no me hayan contado el motivo",
                Pregunta_32 = "32. Me resulta dificil ponerme en el lugar de personas con las que no estoy de acuerdo",
                Pregunta_33 = "33. Me doy cuenta cuando alguien intenta esconder sus verdaderos sentimientos")
datosUIB_T1 <- read_excel("/Users/MariaJose/Desktop/TFG/Encuesta/PID_E_II_int4_T1T2T3_prog_intensivo_4codificado.xlsx", sheet = "EII_int_T1", range = cell_cols("AN:BT")) %>%
  dplyr::rename(Pregunta_1 = '1TECA1', Pregunta_2 = '1TECA2', Pregunta_3 = '1TECA3',Pregunta_4 = '1TECA4', Pregunta_5 = '1TECA5', Pregunta_6 = '1TECA6', Pregunta_7 = '1TECA7', Pregunta_8 = '1TECA8', Pregunta_9 = '1TECA9', Pregunta_10 = '1TECA10', Pregunta_11 =  '1TECA11', Pregunta_12 = '1TECA12', Pregunta_13 = '1TECA13', Pregunta_14 = '1TECA14', Pregunta_15 = '1TECA15', Pregunta_16 = '1TECA16', Pregunta_17 = '1TECA17',Pregunta_18 = '1TECA18', Pregunta_19 = '1TECA19', Pregunta_20 = '1TECA20', Pregunta_21 = '1TECA21',Pregunta_22 = '1TECA22', Pregunta_23 = '1TECA23',Pregunta_24 = '1TECA24', Pregunta_25 = '1TECA25', Pregunta_26 = '1TECA26', Pregunta_27 = '1TECA27', Pregunta_28 = '1TECA28', Pregunta_29 = '1TECA29', Pregunta_30 = '1TECA30', Pregunta_31 = '1TECA31', Pregunta_32 = '1TECA32', Pregunta_33 = '1TECA33')

Juntamos los datos

Invertimos el orden de las respuestas para las preguntas necesarias

Convertimos los "0" en NA.

datos_T1[datos_T1 == "0"] <- NA
#Adopcion de perspectivas

AP <- dplyr::select(datos_T1, Pregunta_6, Pregunta_11, Pregunta_15, Pregunta_17, Pregunta_20, Pregunta_26, Pregunta_29, Pregunta_32)

#Comprension emocional

CE <- dplyr::select(datos_T1, Pregunta_1, Pregunta_7, Pregunta_10, Pregunta_13, Pregunta_14, Pregunta_24, Pregunta_27, Pregunta_31, Pregunta_33)

#Estres empatico

EE <- dplyr::select(datos_T1, Pregunta_3, Pregunta_5, Pregunta_8, Pregunta_12, Pregunta_18, Pregunta_23, Pregunta_28, Pregunta_30)

#Alegria empatica

AE <- dplyr::select(datos_T1, Pregunta_2, Pregunta_4, Pregunta_9, Pregunta_16, Pregunta_19, Pregunta_21, Pregunta_22, Pregunta_25)
#ADOPCION PERSPECTIVAS

#P6 (Falta 1)
AP$Pregunta_6[AP$Pregunta_6 == "2"] <- "1"
AP$Pregunta_6[AP$Pregunta_6 == "3"] <- "2"
AP$Pregunta_6[AP$Pregunta_6 == "4"] <- "3"
AP$Pregunta_6[AP$Pregunta_6 == "5"] <- "4"
#COMPRENSION EMOCIONAL

#P13 (Falta 1)
CE$Pregunta_13[CE$Pregunta_13 == "2"] <- "1"
CE$Pregunta_13[CE$Pregunta_13 == "3"] <- "2"
CE$Pregunta_13[CE$Pregunta_13 == "4"] <- "3"
CE$Pregunta_13[CE$Pregunta_13 == "5"] <- "4"
#ALEGRIA EMPATICA

#P2 (Falta 1)
AE$Pregunta_2[AE$Pregunta_2 == "2"] <- "1"
AE$Pregunta_2[AE$Pregunta_2 == "3"] <- "2"
AE$Pregunta_2[AE$Pregunta_2 == "4"] <- "3"
AE$Pregunta_2[AE$Pregunta_2 == "5"] <- "4"

#P4 (Falta 1)
AE$Pregunta_4[AE$Pregunta_4 == "2"] <- "1"
AE$Pregunta_4[AE$Pregunta_4 == "3"] <- "2"
AE$Pregunta_4[AE$Pregunta_4 == "4"] <- "3"
AE$Pregunta_4[AE$Pregunta_4 == "5"] <- "4"

#P9 (Falta 1)
AE$Pregunta_9[AE$Pregunta_9 == "2"] <- "1"
AE$Pregunta_9[AE$Pregunta_9 == "3"] <- "2"
AE$Pregunta_9[AE$Pregunta_9 == "4"] <- "3"
AE$Pregunta_9[AE$Pregunta_9 == "5"] <- "4"

Procedemos a aplicar el modelo IRT

library(ltm)
## Loading required package: msm
## Loading required package: polycor
#Adopcion perspectivas

irt_AP <- grm(AP)
summary(irt_AP)
## 
## Call:
## grm(data = AP)
## 
## Model Summary:
##    log.Lik      AIC      BIC
##  -1211.361 2500.723 2611.027
## 
## Coefficients:
## $Pregunta_6
##          value
## Extrmt1 -3.688
## Extrmt2 -1.055
## Extrmt3  1.168
## Dscrmn   0.957
## 
## $Pregunta_11
##          value
## Extrmt1 -5.969
## Extrmt2 -3.409
## Extrmt3 -0.279
## Extrmt4  2.555
## Dscrmn   0.702
## 
## $Pregunta_15
##          value
## Extrmt1 -3.265
## Extrmt2 -2.631
## Extrmt3 -0.674
## Extrmt4  0.973
## Dscrmn   1.459
## 
## $Pregunta_17
##          value
## Extrmt1 -5.365
## Extrmt2 -2.305
## Extrmt3  0.024
## Extrmt4  2.437
## Dscrmn   0.816
## 
## $Pregunta_20
##          value
## Extrmt1 -3.271
## Extrmt2 -1.998
## Extrmt3 -0.261
## Extrmt4  1.131
## Dscrmn   1.478
## 
## $Pregunta_26
##          value
## Extrmt1 -3.315
## Extrmt2 -1.927
## Extrmt3 -0.513
## Extrmt4  0.854
## Dscrmn   1.284
## 
## $Pregunta_29
##          value
## Extrmt1 -2.175
## Extrmt2 -1.776
## Extrmt3 -0.542
## Extrmt4  0.901
## Dscrmn   4.198
## 
## $Pregunta_32
##          value
## Extrmt1 -4.408
## Extrmt2 -1.735
## Extrmt3  0.118
## Extrmt4  2.955
## Dscrmn   0.716
## 
## 
## Integration:
## method: Gauss-Hermite
## quadrature points: 21 
## 
## Optimization:
## Convergence: 0 
## max(|grad|): 1.1 
## quasi-Newton: BFGS
plot(irt_AP)

plot(irt_AP, type="IIC")  

#Comprension emocional

irt_CE <- grm(CE)
summary(irt_CE)
## 
## Call:
## grm(data = CE)
## 
## Model Summary:
##    log.Lik      AIC      BIC
##  -1358.626 2805.252 2929.697
## 
## Coefficients:
## $Pregunta_1
##          value
## Extrmt1 -5.023
## Extrmt2 -2.298
## Extrmt3 -0.193
## Extrmt4  2.020
## Dscrmn   1.070
## 
## $Pregunta_7
##          value
## Extrmt1 -6.450
## Extrmt2 -2.681
## Extrmt3  0.314
## Extrmt4  2.840
## Dscrmn   0.668
## 
## $Pregunta_10
##          value
## Extrmt1 -3.851
## Extrmt2 -1.941
## Extrmt3  0.150
## Extrmt4  2.123
## Dscrmn   0.916
## 
## $Pregunta_13
##          value
## Extrmt1 -3.415
## Extrmt2 -1.049
## Extrmt3  0.541
## Dscrmn   1.838
## 
## $Pregunta_14
##          value
## Extrmt1 -3.434
## Extrmt2 -2.477
## Extrmt3 -0.228
## Extrmt4  2.004
## Dscrmn   0.965
## 
## $Pregunta_24
##          value
## Extrmt1 -3.614
## Extrmt2 -1.236
## Extrmt3  1.089
## Extrmt4  3.252
## Dscrmn   0.921
## 
## $Pregunta_27
##          value
## Extrmt1 -2.346
## Extrmt2 -1.190
## Extrmt3 -0.087
## Extrmt4  1.380
## Dscrmn   2.156
## 
## $Pregunta_31
##          value
## Extrmt1 -3.057
## Extrmt2 -2.060
## Extrmt3 -0.609
## Extrmt4  0.822
## Dscrmn   2.234
## 
## $Pregunta_33
##          value
## Extrmt1 -2.345
## Extrmt2 -1.292
## Extrmt3  0.037
## Extrmt4  1.456
## Dscrmn   2.107
## 
## 
## Integration:
## method: Gauss-Hermite
## quadrature points: 21 
## 
## Optimization:
## Convergence: 0 
## max(|grad|): 0.0082 
## quasi-Newton: BFGS
plot(irt_CE)

plot(irt_CE, type="IIC")

#Estres empatico

irt_EE <- grm(EE)
summary(irt_EE)
## 
## Call:
## grm(data = EE)
## 
## Model Summary:
##    log.Lik      AIC      BIC
##  -1390.672 2861.345 2974.477
## 
## Coefficients:
## $Pregunta_3
##          value
## Extrmt1 -3.730
## Extrmt2 -0.832
## Extrmt3  1.803
## Extrmt4  4.857
## Dscrmn   0.641
## 
## $Pregunta_5
##          value
## Extrmt1 -1.778
## Extrmt2 -0.174
## Extrmt3  0.916
## Extrmt4  2.971
## Dscrmn   1.123
## 
## $Pregunta_8
##          value
## Extrmt1 -4.147
## Extrmt2 -2.103
## Extrmt3 -0.554
## Extrmt4  1.654
## Dscrmn   0.858
## 
## $Pregunta_12
##          value
## Extrmt1 -1.727
## Extrmt2 -0.537
## Extrmt3  0.344
## Extrmt4  1.601
## Dscrmn   1.382
## 
## $Pregunta_18
##          value
## Extrmt1 -1.887
## Extrmt2  0.109
## Extrmt3  1.560
## Extrmt4  3.586
## Dscrmn   0.924
## 
## $Pregunta_23
##          value
## Extrmt1 -1.099
## Extrmt2  0.182
## Extrmt3  1.373
## Extrmt4  2.381
## Dscrmn   1.593
## 
## $Pregunta_28
##          value
## Extrmt1 -1.478
## Extrmt2 -0.342
## Extrmt3  0.776
## Extrmt4  2.483
## Dscrmn   1.960
## 
## $Pregunta_30
##          value
## Extrmt1 -3.425
## Extrmt2 -1.612
## Extrmt3 -0.610
## Extrmt4  0.786
## Dscrmn   1.209
## 
## 
## Integration:
## method: Gauss-Hermite
## quadrature points: 21 
## 
## Optimization:
## Convergence: 0 
## max(|grad|): 0.015 
## quasi-Newton: BFGS
plot(irt_EE)

plot(irt_EE, type="IIC")

#Alegria empatica

irt_AE <- grm(AE)
summary(irt_AE)
## 
## Call:
## grm(data = AE)
## 
## Model Summary:
##    log.Lik      AIC      BIC
##  -1047.384 2168.768 2273.415
## 
## Coefficients:
## $Pregunta_2
##          value
## Extrmt1 -2.886
## Extrmt2 -1.263
## Extrmt3  0.111
## Dscrmn   2.512
## 
## $Pregunta_4
##          value
## Extrmt1 -2.866
## Extrmt2 -1.402
## Extrmt3  0.110
## Dscrmn   2.405
## 
## $Pregunta_9
##          value
## Extrmt1 -2.853
## Extrmt2 -1.139
## Extrmt3  0.153
## Dscrmn   2.655
## 
## $Pregunta_16
##          value
## Extrmt1 -2.900
## Extrmt2 -2.548
## Extrmt3 -1.058
## Extrmt4  0.354
## Dscrmn   2.501
## 
## $Pregunta_19
##          value
## Extrmt1 -2.518
## Extrmt2 -1.740
## Extrmt3 -0.516
## Extrmt4  1.170
## Dscrmn   1.825
## 
## $Pregunta_21
##          value
## Extrmt1 -2.817
## Extrmt2 -1.533
## Extrmt3 -0.313
## Extrmt4  1.388
## Dscrmn   1.276
## 
## $Pregunta_22
##          value
## Extrmt1 -3.384
## Extrmt2 -2.479
## Extrmt3 -0.899
## Extrmt4  1.447
## Dscrmn   1.022
## 
## $Pregunta_25
##          value
## Extrmt1 -5.091
## Extrmt2 -2.899
## Extrmt3 -1.391
## Extrmt4  0.213
## Dscrmn   1.038
## 
## 
## Integration:
## method: Gauss-Hermite
## quadrature points: 21 
## 
## Optimization:
## Convergence: 0 
## max(|grad|): 0.0097 
## quasi-Newton: BFGS
plot(irt_AE)

plot(irt_AE, type = "IIC")